Optional Text-display.f

{

: text-field
   show:[ vbuf draw ;] ;

}


{
word wrap - display until next word would overflow a given width then do a (GCR)
centered text with word wrap
justified text with word wrap
recognize line feeds
}

Requires Tools
Requires SORA\Transformations
Requires SORA\Sprites
Requires SORA\Vertices
Requires SORA\Images2

Only Forth Definitions

/Image Inherit
   cell field ->first-char
\   cell field ->last-char
End-struct /Font

0 Value font

2D GL_QUADS Vbuf: text-vbuf

0 Value text-count
Create text-transform /Transform /allot

$ffffffff text-transform ->color !
1.0 1.0 text-transform ->scale 2v!
0.0 text-transform ->roll !

: char[]  ( n font -- sprite )
   dup >r ->first-char @ - /Subimage * r> ->subimages @ + ;

: font-height@   ( font -- n )
   ->subimages @ @height ;

: (font-height)   ( -- n )
   font font-height@ ;

: (char) ( n -- addr )
   font char[] ;

: draw-char ( subimage transform -- )
   over >r fast-sprite  r> @xstride text-transform ->x +! ;

: (gemit)  ( c -- )
   (char) text-transform draw-char
   1 +to text-count ;

: (gtype) ( addr c -- )
   0 ?do dup c@ (gemit) 1+ loop drop ;

: (gcr) ( -- )
   text-transform ->x off
   (font-height) text-transform ->y +! ;

Create gpersonality
   4 cells ,
   7 ,
   0 ,
   0 ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' (gemit) ,
   ' (gtype) ,
   ' (gtype) ,
   ' (gcr) ,

: begin-text  ( font -- )
   to font
   text-transform ->color @ rgba
   0 to text-count
   font bind-image ;

-? 0 value xt
: text-vertices  ( count vbuf xt -- ) ( -- )
   to xt
   gpersonality open-personality
   vertices:[ xt execute ;]
   close-personality ;

:[] draw-text:[ ( font xt -- ) ( -- )
   0 0  text-transform ->x 2v!
   swap begin-text 65536 text-vbuf rot text-vertices
   text-vbuf 0 text-count 4 * draw-some ;

: init-text-display  ( -- )
   ;

: Font:  ( imagefile count fontfile count -- <name> )
   2swap Graphic:     last @ name> >body locals| font |
   /Font /Image - /allot
   here >r cache-file, r> cache-count drop
      h@+ font ->first-char !
      h@+ drop \ font ->last-char !
      font ->subimages ! ;

